home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Demos / ClubMet / ClubMet.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-10-08  |  16.7 KB  |  463 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BackColor       =   &H00000000&
  4.    BorderStyle     =   4  'Fixed ToolWindow
  5.    Caption         =   "Club Metamorphous"
  6.    ClientHeight    =   7140
  7.    ClientLeft      =   3510
  8.    ClientTop       =   1890
  9.    ClientWidth     =   8310
  10.    ForeColor       =   &H0000C000&
  11.    Icon            =   "ClubMet.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   476
  16.    ScaleMode       =   3  'Pixel
  17.    ScaleWidth      =   554
  18.    StartUpPosition =   3  'Windows Default
  19.    Begin VB.CommandButton cmdExit 
  20.       BackColor       =   &H0080FF80&
  21.       Cancel          =   -1  'True
  22.       Caption         =   "Exit"
  23.       Height          =   495
  24.       Left            =   240
  25.       TabIndex        =   12
  26.       Top             =   6600
  27.       Width           =   1215
  28.    End
  29.    Begin VB.CommandButton cmdAdmission 
  30.       BackColor       =   &H00FFC0FF&
  31.       Caption         =   "Admission"
  32.       BeginProperty Font 
  33.          Name            =   "Times New Roman"
  34.          Size            =   9.75
  35.          Charset         =   0
  36.          Weight          =   700
  37.          Underline       =   0   'False
  38.          Italic          =   0   'False
  39.          Strikethrough   =   0   'False
  40.       EndProperty
  41.       Height          =   495
  42.       Left            =   240
  43.       Style           =   1  'Graphical
  44.       TabIndex        =   10
  45.       Top             =   6000
  46.       Width           =   1215
  47.    End
  48.    Begin VB.CommandButton cmdSpecials 
  49.       BackColor       =   &H008080FF&
  50.       Caption         =   "Dinner Specials"
  51.       BeginProperty Font 
  52.          Name            =   "Times New Roman"
  53.          Size            =   9.75
  54.          Charset         =   0
  55.          Weight          =   700
  56.          Underline       =   0   'False
  57.          Italic          =   0   'False
  58.          Strikethrough   =   0   'False
  59.       EndProperty
  60.       Height          =   495
  61.       Left            =   240
  62.       Style           =   1  'Graphical
  63.       TabIndex        =   9
  64.       Top             =   5400
  65.       Width           =   1215
  66.    End
  67.    Begin VB.CommandButton cmdDirections 
  68.       BackColor       =   &H0080C0FF&
  69.       Caption         =   "Directions"
  70.       BeginProperty Font 
  71.          Name            =   "Times New Roman"
  72.          Size            =   9.75
  73.          Charset         =   0
  74.          Weight          =   700
  75.          Underline       =   0   'False
  76.          Italic          =   0   'False
  77.          Strikethrough   =   0   'False
  78.       EndProperty
  79.       Height          =   495
  80.       Left            =   240
  81.       Style           =   1  'Graphical
  82.       TabIndex        =   8
  83.       Top             =   4800
  84.       Width           =   1215
  85.    End
  86.    Begin VB.PictureBox mnCan 
  87.       BackColor       =   &H80000007&
  88.       BorderStyle     =   0  'None
  89.       Height          =   3795
  90.       Left            =   2400
  91.       ScaleHeight     =   253
  92.       ScaleMode       =   3  'Pixel
  93.       ScaleWidth      =   385
  94.       TabIndex        =   7
  95.       Top             =   1680
  96.       Width           =   5775
  97.    End
  98.    Begin VB.Label lblStuff 
  99.       BackColor       =   &H80000007&
  100.       Caption         =   "Label2"
  101.       ForeColor       =   &H8000000E&
  102.       Height          =   1455
  103.       Left            =   2340
  104.       TabIndex        =   11
  105.       Top             =   5580
  106.       Width           =   5835
  107.    End
  108.    Begin VB.Label lblSunday 
  109.       AutoSize        =   -1  'True
  110.       BackColor       =   &H00000000&
  111.       Caption         =   "Sunday"
  112.       BeginProperty Font 
  113.          Name            =   "Times New Roman"
  114.          Size            =   20.25
  115.          Charset         =   0
  116.          Weight          =   700
  117.          Underline       =   0   'False
  118.          Italic          =   0   'False
  119.          Strikethrough   =   0   'False
  120.       EndProperty
  121.       ForeColor       =   &H0000C000&
  122.       Height          =   465
  123.       Left            =   240
  124.       TabIndex        =   6
  125.       Top             =   4200
  126.       Width           =   1305
  127.    End
  128.    Begin VB.Label lblSaturday 
  129.       AutoSize        =   -1  'True
  130.       BackColor       =   &H00000000&
  131.       Caption         =   "Saturday"
  132.       BeginProperty Font 
  133.          Name            =   "Times New Roman"
  134.          Size            =   20.25
  135.          Charset         =   0
  136.          Weight          =   700
  137.          Underline       =   0   'False
  138.          Italic          =   0   'False
  139.          Strikethrough   =   0   'False
  140.       EndProperty
  141.       ForeColor       =   &H0000C000&
  142.       Height          =   465
  143.       Left            =   240
  144.       TabIndex        =   5
  145.       Top             =   3600
  146.       Width           =   1605
  147.    End
  148.    Begin VB.Label lblFriday 
  149.       AutoSize        =   -1  'True
  150.       BackColor       =   &H00000000&
  151.       Caption         =   "Friday"
  152.       BeginProperty Font 
  153.          Name            =   "Times New Roman"
  154.          Size            =   20.25
  155.          Charset         =   0
  156.          Weight          =   700
  157.          Underline       =   0   'False
  158.          Italic          =   0   'False
  159.          Strikethrough   =   0   'False
  160.       EndProperty
  161.       ForeColor       =   &H0000C000&
  162.       Height          =   465
  163.       Left            =   240
  164.       TabIndex        =   4
  165.       Top             =   3000
  166.       Width           =   1185
  167.    End
  168.    Begin VB.Label lblThursday 
  169.       AutoSize        =   -1  'True
  170.       BackColor       =   &H00000000&
  171.       Caption         =   "Thursday"
  172.       BeginProperty Font 
  173.          Name            =   "Times New Roman"
  174.          Size            =   20.25
  175.          Charset         =   0
  176.          Weight          =   700
  177.          Underline       =   0   'False
  178.          Italic          =   0   'False
  179.          Strikethrough   =   0   'False
  180.       EndProperty
  181.       ForeColor       =   &H0000C000&
  182.       Height          =   465
  183.       Left            =   240
  184.       TabIndex        =   3
  185.       Top             =   2400
  186.       Width           =   1695
  187.    End
  188.    Begin VB.Label lblWednesday 
  189.       AutoSize        =   -1  'True
  190.       BackColor       =   &H00000000&
  191.       Caption         =   "Wednesday"
  192.       BeginProperty Font 
  193.          Name            =   "Times New Roman"
  194.          Size            =   20.25
  195.          Charset         =   0
  196.          Weight          =   700
  197.          Underline       =   0   'False
  198.          Italic          =   0   'False
  199.          Strikethrough   =   0   'False
  200.       EndProperty
  201.       ForeColor       =   &H0000FF00&
  202.       Height          =   465
  203.       Left            =   240
  204.       TabIndex        =   2
  205.       Top             =   1800
  206.       Width           =   2025
  207.    End
  208.    Begin VB.Label lblName 
  209.       Alignment       =   2  'Center
  210.       BackColor       =   &H00000000&
  211.       Caption         =   "Club Metamorphous"
  212.       BeginProperty Font 
  213.          Name            =   "Times New Roman"
  214.          Size            =   36
  215.          Charset         =   0
  216.          Weight          =   700
  217.          Underline       =   0   'False
  218.          Italic          =   0   'False
  219.          Strikethrough   =   0   'False
  220.       EndProperty
  221.       ForeColor       =   &H000080FF&
  222.       Height          =   915
  223.       Left            =   480
  224.       TabIndex        =   1
  225.       Top             =   0
  226.       Width           =   7455
  227.    End
  228.    Begin VB.Label Label1 
  229.       BackColor       =   &H00000000&
  230.       Caption         =   """The only thing that stays the same is a good time!"""
  231.       BeginProperty Font 
  232.          Name            =   "Times New Roman"
  233.          Size            =   15.75
  234.          Charset         =   0
  235.          Weight          =   700
  236.          Underline       =   0   'False
  237.          Italic          =   -1  'True
  238.          Strikethrough   =   0   'False
  239.       EndProperty
  240.       ForeColor       =   &H000080FF&
  241.       Height          =   495
  242.       Left            =   840
  243.       TabIndex        =   0
  244.       Top             =   1020
  245.       Width           =   6855
  246.    End
  247. Attribute VB_Name = "frmMain"
  248. Attribute VB_GlobalNameSpace = False
  249. Attribute VB_Creatable = False
  250. Attribute VB_PredeclaredId = True
  251. Attribute VB_Exposed = False
  252. Option Explicit
  253. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  254. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  255. '  File:       ClubMet.frm
  256. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  257. 'This application uses conditional compilation.  To run this sample in the IDE, you
  258. 'must first go to Project Properties (Project Menu-> Properties).  Then on the Make tab
  259. 'change the RunInIDE=0 to RunInIDE=1.
  260. 'This sample also shows developers how to combine the DX7 and DX8 DLL's to create
  261. 'an app with the latest DMusic and still use older functionality like DDraw
  262. Private dx As New DXVBLibA.DirectX8
  263. Dim day As Integer
  264. Dim sJazz As DXVBLibA.DirectMusicStyle8
  265. Dim sDance As DXVBLibA.DirectMusicStyle8
  266. Dim sBigBand As DXVBLibA.DirectMusicStyle8
  267. Dim sDisco As DXVBLibA.DirectMusicStyle8
  268. Dim sClassical As DXVBLibA.DirectMusicStyle8
  269. Dim sHeartland As DXVBLibA.DirectMusicStyle8
  270. Dim cmp As DXVBLibA.DirectMusicChordMap8
  271. Dim com As DXVBLibA.DirectMusicComposer8
  272. Dim perf As DXVBLibA.DirectMusicPerformance8
  273. Dim seg As DXVBLibA.DirectMusicSegment8
  274. Dim loader As DXVBLibA.DirectMusicLoader8
  275. Dim currentstyle As DXVBLibA.DirectMusicStyle8
  276. Dim LabelNumber As Integer
  277. Dim runit As Boolean
  278. Private Sub cmdAdmission_Click()
  279.      Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(2)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
  280.      lblStuff.Caption = ChangeStuffLabel(6)
  281. End Sub
  282. Private Sub cmdDirections_Click()
  283.     Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(0)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
  284.     lblStuff.Caption = ChangeStuffLabel(0)
  285. End Sub
  286. Private Sub cmdExit_Click()
  287.     runit = False
  288.     Unload Me
  289. End Sub
  290. Private Sub cmdSpecials_Click()
  291.      Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(1)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
  292.     lblStuff.Caption = ChangeStuffLabel(LabelNumber)
  293. End Sub
  294. Private Function ChangeStuffLabel(Index As Integer) As String
  295.     Dim tString(9) As String
  296.     Call ClearlblStuff
  297.     'directions
  298.     tString(0) = "Corner of 4th and Stewart, next to the new stadium!"
  299.     'dinners
  300.     tString(1) = "London Broil with Hollandaise sauce, baby red potatoes, green vegetables, and Lobster Bisque soup."
  301.     tString(2) = "Grilled Mahi-Mahi on a bed of rice pilaf, green vegetables, and Ceasar salad"
  302.     tString(3) = "Chicken Cordon Bleu, steamed vegetables, wild lemon rice, and clam chowder"
  303.     tString(4) = "Bacon CheeseBurger, onion rings, and a vanilla shake"
  304.     tString(5) = "Salmon in parchment, rice pilaf, green vegetables, and lentil soup."
  305.     'Admission
  306.     tString(6) = "Age 14 - 18, $4.50, age 19 and up, $7.00"
  307.     ChangeStuffLabel = tString(Index)
  308. End Function
  309. Private Sub ClearlblStuff()
  310.     lblStuff.Caption = ""
  311. End Sub
  312. Private Sub Form_Load()
  313.     On Error GoTo err_out
  314.     Show
  315.     ClearlblStuff
  316.     InitDD hwnd, mnCan
  317.     DoEvents
  318.     initDMusic
  319.     DoEvents
  320.     runit = True
  321.     Do
  322.         MoveFrame day
  323.         DoEvents
  324.     Loop
  325.     End
  326. err_out:
  327.     MsgBox "Could not start application!", vbApplicationModal
  328.     End
  329.         
  330. End Sub
  331. Private Sub initDMusic()
  332.     Dim dma As DMUS_AUDIOPARAMS
  333.     On Error GoTo FailedInit
  334.     Set perf = dx.DirectMusicPerformanceCreate
  335.     Set com = dx.DirectMusicComposerCreate
  336.     Set loader = dx.DirectMusicLoaderCreate
  337.     perf.InitAudio Me.hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
  338.     perf.SetMasterAutoDownload True
  339. 'Load the objects
  340. #If RunInIDE = 1 Then
  341.     Dim sMedia As String
  342.     sMedia = FindMediaDir("bigband.sty")
  343.     If sMedia <> vbNullString Then 'Media is not in current folder
  344.         If (Left$(sMedia, 2) <> Left$(CurDir, 2)) And (InStr(Left$(sMedia, 2), ":") > 0) Then ChDrive Left$(sMedia, 2)
  345.         ChDir sMedia
  346.     End If
  347.     Set sBigBand = loader.LoadStyle("BIGBAND.STY")
  348.     Set sJazz = loader.LoadStyle("JAZZ.STY")
  349.     Set sDisco = loader.LoadStyle("DISCO.STY")
  350.     Set sClassical = loader.LoadStyle("CLASSICAL.STY")
  351.     Set sDance = loader.LoadStyle("DANCEMIX.STY")
  352.     Set sHeartland = loader.LoadStyle("HEARTLAND.STY")
  353.     Set currentstyle = sHeartland
  354.     Set cmp = loader.LoadChordMap("CHORDMAP.CDM")
  355. #Else
  356.     Set sBigBand = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "BIGBAND")
  357.     Set sJazz = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "JAZZ")
  358.     Set sDisco = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "DISCO")
  359.     Set sClassical = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "CLASSICAL")
  360.     Set sDance = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "DANCEMIX")
  361.     Set sHeartland = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "HEARTLAND")
  362.     Set currentstyle = sHeartland
  363.     Set cmp = loader.LoadChordMapFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "CHORDMAP")
  364. #End If
  365.     Set seg = com.ComposeSegmentFromShape(sHeartland, 64, 0, 1, True, False, cmp)
  366.     Call perf.PlaySegmentEx(seg, 0, 0)
  367.     Exit Sub
  368. FailedInit:
  369.     MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
  370.     Unload Me
  371. End Sub
  372. Private Sub ChangeMusic()
  373.     Set seg = com.ComposeSegmentFromShape(currentstyle, 64, 0, 2, False, False, cmp)
  374.     Call com.AutoTransition(perf, seg, DMUS_COMMANDT_FILL, DMUS_COMPOSEF_MEASURE, cmp)
  375. End Sub
  376. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  377.     runit = False
  378. End Sub
  379. Private Sub Form_Unload(Cancel As Integer)
  380.     If Not (perf Is Nothing) Then perf.CloseDown
  381.     End
  382. End Sub
  383. Private Sub lblFriday_Click()
  384.     ClearlblStuff
  385.     Set currentstyle = sDisco
  386.     ChangeMusic
  387.     day = 2: LabelNumber = 3
  388.     lblStuff.Caption = LoadMSg(2)
  389. End Sub
  390. Private Sub lblFriday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  391.     lblName.Font = "Courier New"
  392.     lblName.ForeColor = &H8080FF
  393.     lblFriday.ForeColor = &HFF&
  394.     lblWednesday.ForeColor = &HC000&
  395.     lblThursday.ForeColor = &HC000&
  396.     lblSaturday.ForeColor = &HC000&
  397.     lblSunday.ForeColor = &HC000&
  398. End Sub
  399. Private Sub lblSaturday_Click()
  400.     ClearlblStuff
  401.     Set currentstyle = sDance
  402.     ChangeMusic
  403.     day = 6: LabelNumber = 4
  404.     lblStuff.Caption = LoadMSg(3)
  405. End Sub
  406. Private Sub lblSaturday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  407.     lblName.Font = "Tahoma"
  408.     lblName.ForeColor = &HC00000
  409.     lblSaturday.ForeColor = &HFF&
  410.     lblWednesday.ForeColor = &HC000&
  411.     lblThursday.ForeColor = &HC000&
  412.     lblFriday.ForeColor = &HC000&
  413.     lblSunday.ForeColor = &HC000&
  414. End Sub
  415. Private Sub lblSunday_Click()
  416.     ClearlblStuff
  417.     Set currentstyle = sClassical
  418.     ChangeMusic
  419.     day = 5: LabelNumber = 5
  420.     lblStuff.Caption = LoadMSg(4)
  421. End Sub
  422. Private Sub lblSunday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  423.     lblName.Font = "Garamond"
  424.     lblName.ForeColor = &HFFC0C0
  425.     lblSunday.ForeColor = &HFF&
  426.     lblWednesday.ForeColor = &HC000&
  427.     lblThursday.ForeColor = &HC000&
  428.     lblFriday.ForeColor = &HC000&
  429.     lblSaturday.ForeColor = &HC000&
  430. End Sub
  431. Private Sub lblThursday_Click()
  432.     ClearlblStuff
  433.     Set currentstyle = sJazz
  434.     ChangeMusic
  435.     day = 3: LabelNumber = 2
  436.     lblStuff.Caption = LoadMSg(1)
  437. End Sub
  438. Private Sub lblThursday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  439.     lblName.Font = "Comic Sans MS"
  440.     lblName.ForeColor = &H80FF80
  441.     lblThursday.ForeColor = &HFF&
  442.     lblWednesday.ForeColor = &HC000&
  443.     lblFriday.ForeColor = &HC000&
  444.     lblSaturday.ForeColor = &HC000&
  445.     lblSunday.ForeColor = &HC000&
  446. End Sub
  447. Private Sub lblWednesday_Click()
  448.     ClearlblStuff
  449.     Set currentstyle = sBigBand
  450.     ChangeMusic
  451.     day = 1: LabelNumber = 1
  452.     lblStuff.Caption = LoadMSg(0)
  453. End Sub
  454. Private Sub lblWednesday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  455.     lblName.Font = "Times New Roman"
  456.     lblName.ForeColor = &HFFFF&
  457.     lblWednesday.ForeColor = &HFF&
  458.     lblThursday.ForeColor = &HC000&
  459.     lblFriday.ForeColor = &HC000&
  460.     lblSaturday.ForeColor = &HC000&
  461.     lblSunday.ForeColor = &HC000&
  462. End Sub
  463.